home *** CD-ROM | disk | FTP | other *** search
/ Perusromppu 2 / Perusromppu 2 - 40 suomenkielistä opetusohjelmaa.iso / perusr2 / mmlab / keyboard.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-03  |  11KB  |  366 lines
  1. { -------------------------------------------------------------------- }
  2. {                                                                      }
  3. { Copyright (c) Gävle DPC 1993                                         }
  4. {                                                                      }
  5. { You have the right to use,reproduce, modify and distribute this file }
  6. { if you find it useful, provided that you agree that                  }
  7. { Gävle DPC has no warranty obligations or liability for any           }
  8. { errors caused by the file.                                           }
  9. {                                                                      }
  10. {                                                                      }
  11. { -------------------------------------------------------------------- }
  12. { 94xxxx M.E.                                                          }
  13. { -------------------------------------------------------------------- }
  14.  
  15. PROGRAM MML_Template;
  16.  
  17. {$IFDEF MML}
  18.   {$D+,L+}
  19. {$ELSE}
  20.   {$D-,L-}
  21. {$ENDIF}
  22.  
  23. {$I DEPEND.INC}
  24.  
  25. USES  Strings,
  26.       WinTypes,
  27.       WinProcs,
  28.       MMSystem,
  29.       OLE,
  30.  
  31.       OWindows,
  32.  
  33.       MMLRun,
  34.       MMLDefs,
  35.       MMLLib,
  36.       MMLMemory,
  37.       MMLOLE,
  38.       MMLPages,
  39.  
  40.       Pages;     { Auto generated unit }
  41.  
  42. {$R MML.RES}
  43.  
  44. { ------------------------------------------------------------------------ }
  45.  
  46. TYPE  DemoApplication_ = OBJECT(TApplication)
  47.                            CONSTRUCTOR Init(AName : PChar);
  48.                            DESTRUCTOR  Done;                     VIRTUAL;
  49.                            PROCEDURE   InitMainWindow;           VIRTUAL;
  50.                          END;
  51.  
  52. TYPE  DemoWindowPtr_   = ^DemoWindow_;
  53.       DemoWindow_      = OBJECT(TWindow)
  54.                           Pages     : PagesPtr_;
  55.                           HasTimer  : Boolean;
  56.                           InTimer   : Boolean;
  57.                           IdleStart : Longint;
  58.                           Focused   : Boolean;
  59.  
  60.                           CONSTRUCTOR Init(AParent : PWindowsObject);
  61.                           DESTRUCTOR  Done;                                  VIRTUAL;
  62.  
  63.                           PROCEDURE   SetupWindow;                           VIRTUAL;
  64.  
  65.                           FUNCTION  GetClassname : PChar;                    VIRTUAL;
  66.                           PROCEDURE GetWindowClass(VAR WndClass: TWndClass); VIRTUAL;
  67.  
  68.                     { ---------------------------------------------------- }
  69.  
  70.                           PROCEDURE Paint(PaintDC       : HDC;
  71.                       VAR PaintInfo : TPaintStruct);     VIRTUAL;
  72.  
  73.                           PROCEDURE WMLButtonDown(VAR msg : TMessage);
  74.                                     VIRTUAL wm_First+WM_LButtonDown;
  75.                           PROCEDURE WMRButtonDown(VAR msg : TMessage);
  76.                                     VIRTUAL wm_First+WM_RButtonDown;
  77.  
  78.                           PROCEDURE WMSetCursor(VAR Msg : TMessage);
  79.                                     VIRTUAL wm_First+wm_SetCursor;
  80.  
  81.                           PROCEDURE WMTimer(VAR Msg : TMessage);
  82.                                     VIRTUAL wm_First+wm_Timer;
  83.  
  84.                           PROCEDURE WMKeyDown(VAR Msg : TMessage);
  85.                                     VIRTUAL wm_First+wm_KeyDown;
  86.  
  87.                     { ---------------------------------------------------- }
  88.  
  89.                           PROCEDURE CMReleaseMemory(VAR Msg : TMessage);
  90.                                     VIRTUAL cm_First+cm_ReleaseMemory;
  91.  
  92.                           PROCEDURE SetTitle(Force : Boolean);
  93.                           FUNCTION  IsFocused   : Boolean;
  94.  
  95.                           PROCEDURE BreakIdle;
  96.                           FUNCTION  GetIdleTime : Longint;
  97.  
  98.                           PROCEDURE StartExecution;
  99.                           PROCEDURE StopExecution;
  100.                END;
  101.  
  102. { ------------------------------------------------------------------------ }
  103.  
  104. FUNCTION ClientCallBack(Client       : POleClient;
  105.                         Notification : TOle_Notification;
  106.                         OleObject    : POleObject): Integer; EXPORT;
  107.   BEGIN
  108.     ClientCallBack:=1;
  109.     {
  110.     CASE Notification OF
  111.       ole_Changed,
  112.       ole_Saved,
  113.       ole_Renamed : ;
  114.     END;
  115.     }
  116.   END;
  117.  
  118. { -------------------------------------- }
  119.  
  120. CONSTRUCTOR DemoApplication_.Init(AName : PChar);
  121.   BEGIN
  122.     @OLEClientVTbl.CallBack:=MakeProcInstance(@ClientCallBack,HInstance);
  123.     OLEClient.lpvtbl:=@OLEClientVTbl;
  124.  
  125.     CFOwnerLink:=RegisterClipboardFormat('OwnerLink');
  126.     CFObjectLink:=RegisterClipboardFormat('ObjectLink');
  127.  
  128.     OleRegisterClientDoc('MML','NONAME',0,OLEClientDoc);
  129.     RegisterOLE(OLEClientVtbl,OLEClient,OLEClientDoc);
  130.  
  131.     INHERITED Init(AName);
  132.   END;
  133.  
  134. DESTRUCTOR DemoApplication_.Done;
  135.   BEGIN
  136.     OleRevokeClientDoc(OLEClientDoc);
  137.     FreeProcInstance(@OleClientVTbl.CallBack);
  138.     INHERITED Done;
  139.   END;
  140.  
  141. PROCEDURE DemoApplication_.InitMainWindow;
  142.   BEGIN
  143.     MainWindow:=New(DemoWindowPtr_,Init(NIL));
  144.   END;
  145.  
  146. { -------------------------------------------------------------------------- }
  147.  
  148. CONSTRUCTOR DemoWindow_.Init(AParent : PWindowsObject);
  149.   BEGIN
  150.      INHERITED Init(AParent,PageLayout.Title);
  151.  
  152.     IF (PageLayout.UseTitle) THEN
  153.       Attr.Style:=ws_Visible OR ws_Overlapped OR ws_SysMenu OR ws_Caption
  154.     ELSE
  155.       Attr.Style:=ws_Visible OR ws_PopUpWindow;
  156.  
  157.     Attr.x:=0;
  158.     Attr.y:=0;
  159.     Attr.w:=PageLayout.Width;
  160.     Attr.h:=PageLayout.Height;
  161.  
  162.     Pages:=CreatePages(PageLayout.BkColour);
  163.  
  164.     IF (Pages=NIL) THEN
  165.       Fail;
  166.   END;
  167.  
  168. DESTRUCTOR DemoWindow_.Done;
  169.   BEGIN
  170.     StopExecution;
  171.     IF (Pages<>NIL) THEN
  172.       Dispose(Pages,Kill);
  173.     DestroyCursor(ButtonCursor);
  174.  
  175.     INHERITED Done;
  176.   END;
  177.  
  178. PROCEDURE DemoWindow_.SetupWindow;
  179.   BEGIN
  180.     INHERITED SetupWindow;
  181.     MainWindow:=HWindow;
  182.     MainTask:=GetCurrentTask;
  183.     ButtonCursor:=LoadCursor(HInstance,MakeIntResource(cursor_Area));
  184.     Pages^.AllocMemory;   { Load bitmaps ... }
  185.     StartExecution;
  186.   END;
  187.  
  188. FUNCTION DemoWindow_.GetClassname : PChar;
  189.   BEGIN
  190.     GetClassname:='DemoWindow';
  191.   END;
  192.  
  193. PROCEDURE DemoWindow_.GetWindowClass(VAR WndClass : TWndClass);
  194.   BEGIN
  195.     TWindow.GetWindowClass(WndClass);
  196.     WndClass.hbrBackground:=CreateSolidBrush(PageLayout.BkColour);
  197.     WndClass.HIcon:=LoadIcon(HInstance,MakeIntResource(icon_Programme));
  198.   END;
  199.  
  200. CONST FirstPaint : Boolean = True;
  201.  
  202. PROCEDURE DemoWindow_.Paint(PaintDC       : HDC;
  203.                             VAR PaintInfo : TPaintStruct);
  204.   BEGIN
  205.     IF (Pages<>NIL) THEN BEGIN
  206.       IF (FirstPaint) THEN BEGIN
  207.         FirstPaint:=False;
  208.         Pages^.Run(PageLayout.MouseJumps);
  209.       END ELSE
  210.         Pages^.UpdateScreen(PaintDC,@PaintInfo.RCPaint);
  211.     END;
  212.   END;
  213.  
  214. PROCEDURE DemoWindow_.WMLButtonDown(VAR Msg : TMessage);
  215.   BEGIN
  216.     IF (Pages<>NIL) THEN BEGIN
  217.       IF (NOT Pages^.MouseDown(GraphC_(Msg.LParamLo),GraphC_(Msg.LParamHi))) THEN BEGIN
  218.         IF (PageLayout.MouseJumps) AND (NOT Pages^.InWaitMode) THEN
  219.            Pages^.NextPage;
  220.       END;
  221.  
  222.       BreakIdle;
  223.     END;
  224.   END;
  225.  
  226. PROCEDURE DemoWindow_.WMRButtonDown(VAR Msg : TMessage);
  227.   BEGIN
  228.     IF (Pages<>NIL) THEN BEGIN
  229.       IF (PageLayout.MouseJumps) AND (NOT Pages^.InWaitMode) THEN
  230.         Pages^.PrevPage;
  231.  
  232.       BreakIdle;
  233.     END;
  234.   END;
  235.  
  236. PROCEDURE DemoWindow_.WMSetCursor(VAR Msg : TMessage);
  237.   VAR Pt : TPoint;
  238.       R  : TRect;
  239.  
  240.   BEGIN
  241.     BreakIdle;
  242.  
  243.     GetCursorPos(Pt);
  244.     ScreenToClient(HWindow,Pt);
  245.     GetClientRect(HWindow,R);
  246.  
  247.     IF (Pages<>NIL) AND (PtInRect(R,Pt)) THEN
  248.       Pages^.SetMouseCursor(Pt.x,Pt.y)
  249.     ELSE
  250.       DefWndProc(Msg);
  251.   END;
  252.  
  253. PROCEDURE DemoWindow_.WMTimer(VAR Msg : TMessage);
  254.   BEGIN
  255.     IF (NOT InTimer) THEN BEGIN
  256.       TimerUpdateMCIDevices;
  257.  
  258.       SetTitle(False);
  259.       IF (Pages<>NIL) AND (IsFocused) AND (NOT FirstPaint) THEN BEGIN
  260.         IF (PageLayout.UseIdle) AND (GetIdleTime>PageLayout.IdleTime) THEN
  261.           Pages^.IdleAction(PageLayout.IdlePage)
  262.         ELSE BEGIN
  263.           Pages^.ExecuteNext;
  264.           IF (Pages^.ExecutionStopped) THEN BEGIN
  265.             StopExecution;
  266.             CloseWindow;
  267.           END;
  268.         END;
  269.       END;
  270.     END;
  271.   END;
  272.  
  273. PROCEDURE DemoWindow_.WMKeyDown(VAR Msg : TMessage);
  274.   BEGIN
  275.     IF (Msg.WParam=vk_Escape) THEN
  276.       PostMessage(HWindow,wm_SysCommand,sc_Close,0);
  277.     DefWndProc(Msg);
  278.   END;
  279.  
  280. PROCEDURE DemoWindow_.CMReleaseMemory(VAR Msg : TMessage);
  281.   BEGIN
  282.     IF (Pages<>NIL) THEN
  283.       Pages^.ReleaseMemory(GetLowMemoryLimit);
  284.   END;
  285.  
  286. PROCEDURE DemoWindow_.SetTitle(Force : Boolean);
  287.   VAR IdleLeft : Word;
  288.       Tmp      : StrZ_;
  289.       Tmp2     : StrZ_;
  290.  
  291.   BEGIN
  292.     IdleLeft:=Max(0,PageLayout.IdleTime-GetIdleTime);
  293.  
  294.     IF (PageLayout.UseIdle) AND (IdleLeft<=10) THEN BEGIN
  295.       Str(IdleLeft,Tmp);
  296.       SetWindowText(HWindow,Tmp);
  297.     END ELSE IF (Force) OR (Focused<>IsFocused) THEN BEGIN
  298.       Focused:=IsFocused;
  299.       StrCopy(Tmp,PageLayout.Title);
  300.       IF (NOT Focused) THEN BEGIN
  301.         LoadString(HInstance,txt_Paused,Tmp2,SizeOf(Tmp2));
  302.         StrCat(Tmp,Tmp2);
  303.       END;
  304.       SetWindowText(HWindow,Tmp);
  305.     END;
  306.   END;
  307.  
  308. FUNCTION DemoWindow_.IsFocused : Boolean;
  309.   BEGIN
  310.     IsFocused:=(GetFocus=HWindow);
  311.   END;
  312.  
  313. PROCEDURE DemoWindow_.BreakIdle;
  314.   BEGIN
  315.     IF (PageLayout.UseIdle) THEN BEGIN
  316.       IF (PageLayout.IdleTime-GetIdleTime<=10) THEN BEGIN
  317.         IdleStart:=TimeGetTime;
  318.         SetTitle(True);
  319.       END ELSE
  320.         IdleStart:=TimeGetTime;
  321.     END;
  322.   END;
  323.  
  324. FUNCTION DemoWindow_.GetIdleTime : Longint;     { In seconds }
  325.   VAR CurTime : Longint;
  326.  
  327.   BEGIN
  328.     CurTime:=TimeGetTime;
  329.     IF (CurTime<IdleStart) THEN BEGIN
  330.       IdleStart:=CurTime;
  331.       GetIdleTime:=0;
  332.     END ELSE
  333.       GetIdleTime:=(CurTime-IdleStart) DIV 1000;
  334.   END;
  335.  
  336. PROCEDURE DemoWindow_.StartExecution;
  337.   BEGIN
  338.     IF (SetTimer(HWindow,0,100,NIL)=0) THEN
  339.       MessageBox(HWindow,'Couldn''t create timer',NIL,mb_ok)
  340.     ELSE BEGIN
  341.       HasTimer:=True;
  342.       InTimer:=False;
  343.       Focused:=False;
  344.       IdleStart:=TimeGetTime;
  345.     END;
  346.   END;
  347.  
  348. PROCEDURE DemoWindow_.StopExecution;
  349.   BEGIN
  350.     IF (HasTimer) THEN BEGIN
  351.       KillTimer(HWindow,0);
  352.       HasTimer:=False;
  353.     END;
  354.   END;
  355.  
  356. { ---------------------------------------------------------------------- }
  357. { ---------------------------------------------------------------------- }
  358.  
  359. VAR Application : DemoApplication_;
  360.  
  361. BEGIN
  362.   Application.Init('');
  363.   Application.Run;
  364.   Application.Done;
  365. END.
  366.